(import (scheme base))
(import (scheme write))

(import (scheme time))
(import (prefix (clock system) system-clock:))
(import (clock tai))
(import (clock tai-to-utc-offset))

(set-open-leap-seconds-list-port! (lambda () #f))

(define (time what p)
  (define interval 60.0)
  (define (time-helper p)
    (let ((start (current-second)))
      (let loop ((n 1))
        (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p)
        (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p)
        (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p)
        (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p)
        (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p) (p)(p)(p)(p)(p)
        (if (< (current-second) (+ interval start))
          (loop (+ n 100))
          n))))
  (display "IMPLEMENTATION: ")
  (display what)
  (display "\n")
  (flush-output-port)
  (display (exact (truncate (* 1e9 (/ interval (time-helper p))))))
  (display " ns/call\n")
  (flush-output-port))

(define (nop) 0.0)
(when #t
  (time "nop" nop))

(define (tak x y z)
  (if (not (< y x))
    z
    (tak (tak (- x 1) y z) (tak (- y 1) z x) (tak (- z 1) x y))))
(when #t
  (time "tak"
        (lambda () (tak 18 12 6))))

(when #t
  (time (string-append "current-second from (scheme time)")
        current-second))

(define (corrected-current-second)
  (let ((s (current-second)))
    (if (< s 1341100834.0)
      s
      (+ s 1.0))))
(when #t
  (time (string-append "corrected current-second")
        corrected-current-second))

(when #t
  (time (string-append "the " (symbol->string system-clock:type) " system-clock")
        (lambda ()
          (system-clock:call-with-current-clock-values (lambda (second leap-second-indicator) second)))))

(when #t
  (time (string-append "tai clock derived from the " (symbol->string system-clock:type) " system clock")
        (make-tai-clock system-clock:type
                        system-clock:call-with-current-clock-values)))
